HPAVC/HPAVC CD-ROM.iso/pc/KMAGV2.ZIP/READER.PAS

Pascal/Delphi Source File | 1995-06-02 | 5.3 KB | 190 lines

{*******************************************************************}
{***  This program made for my mother , to put all her "MTKONS"  ***}
{*******************************************************************}

Uses Fcrt,Crt,Heb,Printer;

{$I MTKON.INC}

Var
    Mtkon: MtkonType;            {The MTKON that we gonna show.}
    Opt:AllAddress;                 {The Main Menu Type.}
    Files:AllF;                     {The Second Menu Type.}
    T,T1:Byte;
    F:File;
    Num:Byte;

{* Load The Main menu *}

Procedure LoadMain;
Begin

    New(Opt);
    Assign(F,'Main.Mnu');
    Reset(F,1);
    BlockRead(F,Opt^,SizeOf(AllAddressP));
    Close(F);

End;
{* The Procedure made the first main menu *}

Function Menu1 : Byte;
Var
    T,T1:Byte;
    Where:Byte;
    WhereY:Byte;
    Ch:Char;
Begin
    Where:=1;
    WhereY:=1;
    For T:=1 To 80 Do
    Begin
        For T1:=1 To 25 Do
        Begin
            WriteStr(T,T1,'░',1,7);
        End;
    End;

    FlipPage(Tscreen1,Tscreen);
    Repeat
        Windows(30,2,80-30,24,15,1,false);
        For T:=Where To Where+20 Do
        Begin
            If T=Opt^.Num Then Break;
            WriteStr(30+10-(length(Opt^.Name[T].Line) Div 2),T+2-Where+1,Opt^.Name[T].Line,15,1);
        End;
        For T:=1 To 19 Do
            WriteStr(T+30,WhereY+2,Tscreen1[WhereY+2,T+30].ch,15,2);
        FlipPage(Tscreen1,Tscreen);
        If KeyPressed Then Ch:=Readkey;
        Case ord(Ch) Of
            72:
            Begin
                Dec(WhereY);
            End;
            80:
            Begin
                Inc(WhereY);
            End;
        End;
        If WhereY > 21 Then Begin Dec(WhereY);Inc(Where);End;
        If WhereY < 1 Then Begin Inc(WhereY);Dec(Where);End;
        If WhereY > Opt^.Num -1 Then Begin Dec(WhereY);End;
        If Where < 1 Then Begin Inc(Where);End;
        If (Where > Opt^.Num - 1 - 20) And (Opt^.Num > 20) Then Begin Dec(Where);End;
        if ch<>#13 Then Ch :='1';
    Until(Ch = #13);
    Menu1 := Where + WhereY - 1;
End;
Function Menu2(Num:Byte) : Byte;
Begin

End;
{* Show the Mtkon with scroll bars and much more options. *}

Procedure ShowWindow(X,Y,X1,Y1:Byte;Mtkon:MtkonType);

Var T , T1 : Byte;
    Precent : Word;
    LineY : Integer;
    YPlace : Word;
    Ch:Char;
    XX,YY:Word;
Begin
    LineY := 0;
    Windows(X,Y,X1,Y1,15,1,False);
    WriteStr(((X1 - X) Div 2) - ((Length(Mtkon^.Name)+2) Div 2)+X,Y,' '+Mtkon^.Name+' ',15,1);
    WriteStr(X1,Y+1,'',1,3);
    WriteStr(X1,Y1-1,'',1,3);
    Precent := Y1 - Y - 4;
    For T:=Y+2 to Y1-2 Do
    Begin
        WriteStr(X1,T,'▒',1,3);
    End;

    FlipPage(Tscreen1,Tscreen2);
    Ch:=Chr(0);
    Repeat

        If (KeyPressed) Then Ch := ReadKey;
        Ch := UpCase(Ch);
        If (ord(Ch)=$10) Then
            Begin
                Asm
                    Mov Ax,$3
                    Int 10h
                End;
                Halt;
            ENd;
        If (ord( Ch)=$19) Then
            Begin
                For YY:=1 To Mtkon^.Lines Do
                Begin
                    For XX:=1 To 78 Do
                    Begin
                        Write(Lst,Mtkon^.Mtkon[YY,XX]);
                    End;
                    Writeln(Lst);
                End;
            ENd;
        Case Ord(Ch) Of
            72:    Dec(LineY);
            80:    Inc(LineY);
            73: LineY := LineY - (Y1 + Y) + 5;
            81: LineY := LineY + (Y1 + Y) - 5;
        End;

        YPlace := (Precent * LineY) Div (Mtkon^.Lines - 21);
{        YPlace := 1;
        LineY :=   (Mtkon.Lines * YPlace) Div (Precent)+1;}
        If LineY >= Mtkon^.Lines-21 Then
            LineY := Mtkon^.Lines-21 ;
        If LineY <= 0 Then
            LineY := 0;
        WriteStr(X1,Y + 2 + YPlace,'+',1,3);
        For T:=1 To Y1-Y-1 Do
        Begin
            For T1:=1 To X1-X-1 Do
                WriteStr(X+T1,Y+T+2-2,Mtkon^.Mtkon[T+LineY,T1],14,1);
        End;

        WriteStr(X+10,Y1,' ' +IntToStr(LineY)+ ' ',15,1);
        If GetShiftL Then WriteStr(X,Y1+1,'SHIFTL',0,7);
        If GetShiftR Then WriteStr(X+10,Y1+1,'SHIFTR',0,7);
        If GetCtrl Then WriteStr(X+20,Y1+1,'CTRL',0,7);
        If GetAlt Then WriteStr(X+28,Y1+1,'ALT',0,7);
        If GetSl Then WriteStr(X+35,Y1+1,'SCRLLOCK',0,7);
        If GetNl Then WriteStr(X+47,Y1+1,'NUMLOCK',0,7);
        If GetCl Then WriteStr(X+58,Y1+1,'CAPSLOCK',0,7);
        If (ord(Ch)=$1E) Then
            Begin
                Windows(10,5,70,17,15,4,True);
                WriteStr(11,6,'                           ABOUT',15,4);
                WriteStr(11,7,'                           -----',15,4);
                WriteStr(11,9,'          The Programming Magazine Reader Ver 1.0  ',15,4);
                WriteStr(11,10,'                 Made By The I<ing in 1995  ',15,4);
                WriteStr(11,13,'                 Just for all of u to know. ',15,4);
                WriteStr(11,14,'             this isn''t a TURBO VISION Program!',15,4);
                 FlipPage(Tscreen1,Tscreen);
                Ch:=Readkey;
            End;
        FlipPage(Tscreen1,Tscreen);
        FlipPage(Tscreen2,Tscreen1);
        Ch := '~';
    Until(Ch='q');
End;

{* MAIN PROGRAM *}
Begin

{    Num :=Menu1;
    Num :=Menu2(Num);}
    ClrScr;
    New(Mtkon);
    FillChar(Mtkon^.Mtkon,800*80,0);
    Txt2Mtk(Mtkon,'MagVol3.Txt');
    WriteStr1(1,1,'  ~EA~bout  ~EP~rint  ~EQ~uit                                                            ',0,7);
    WriteStr1(1,25,'                                                                                            ',0,7);
    Mtkon^.Name := 'Programing Magazine Volume 2';
    ShowWindow(1,2,80,24,Mtkon);
End.